home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / PROGRAMR / DIB.ZIP / BLIT4.PAS < prev    next >
Pascal/Delphi Source File  |  1991-12-05  |  3KB  |  142 lines
  1. Program Blit4;
  2.  
  3. { BitBlt and StretchBlt a 4 bit per pixel (16 color) bitmap }
  4.  
  5. {$R BLIT4.RES}
  6.  
  7. Uses
  8.   WinTypes,WinProcs,WObjects;
  9.  
  10. Const
  11.   id_FridgeBmp = 'FRIDGE';
  12.  
  13.   Factor : Real = 2.0;
  14.  
  15. {---------------------------------------------------}
  16.  
  17. { --- App/Win Object declarations --- }
  18.  
  19. Type
  20.   TBlitApp = Object(TApplication)
  21.                   Procedure InitMainWindow; Virtual;
  22.                 End;
  23.  
  24.   PBlitWindow = ^BlitWindow;
  25.   BlitWindow = Object(TWindow)
  26.                  hFridgeBmp : HBitmap;
  27.  
  28.                  Constructor Init(AParent: PWindowsObject; ATitle : PChar);
  29.  
  30.                  Destructor Done;
  31.                    Virtual;
  32.  
  33.                  Procedure Paint(PaintDC : HDC; Var PaintInfo : TPaintStruct);
  34.                    Virtual;
  35.  
  36.                  Procedure WMLButtonDown(Var Msg : TMessage);
  37.                    Virtual wm_First + wm_LButtonDown;
  38.  
  39.                  Procedure WMRButtonDown(Var Msg : TMessage);
  40.                    Virtual wm_First + wm_RButtonDown;
  41.  
  42.                End;
  43.  
  44. {---------------------------------------------------}
  45.  
  46. { --- App Methods --- }
  47.  
  48. Procedure TBlitApp.InitMainWindow;
  49.  
  50. Begin
  51.   MainWindow := New(PBlitWindow,Init(nil,'Blit 4-Bit Bitmap'));
  52. End {InitMainWindow};
  53.  
  54. {---------------------------------------------------}
  55.  
  56. { --- Window Methods --- }
  57.  
  58. Constructor BlitWindow.Init(AParent : PWindowsObject; ATitle : PChar);
  59.  
  60. Begin
  61.   TWindow.Init(AParent,ATitle);
  62.  
  63.   hFridgeBmp := LoadBitmap(HInstance,id_FridgeBmp);
  64. End {Init};
  65.  
  66. {---------------------------------------------------}
  67.  
  68. Destructor BlitWindow.Done;
  69.  
  70. Begin
  71.   DeleteObject(hFridgeBmp);
  72.   TWindow.Done;
  73. End {Done};
  74.  
  75. {---------------------------------------------------}
  76.  
  77. Procedure BlitWindow.Paint(PaintDC : HDC; Var PaintInfo : TPaintStruct);
  78.  
  79. Var
  80.   OldBitmap : HBitmap;
  81.   MemDC : HDC;
  82.   BitmapSize : TPoint;
  83.   BmpInfo : TBitmap;
  84.  
  85. Begin
  86.   { Create a memory DC and select our bmp into it }
  87.   MemDC := CreateCompatibleDC(PaintDC);
  88.   OldBitmap := SelectObject(MemDC,hFridgeBmp);
  89.  
  90.   { Get the bmp's size }
  91.   GetObject(hFridgeBmp,SizeOf(TBitmap),@BmpInfo);
  92.   BitmapSize.x := BmpInfo.bmWidth;
  93.   BitmapSize.y := BmpInfo.bmHeight;
  94.  
  95.   { Blit the bmp }
  96.   BitBlt(PaintDC,10,10,BitmapSize.x,BitmapSize.y,MemDC,0,0,srcCopy);
  97.  
  98.   { Stretch blit the bmp }
  99.   StretchBlt(PaintDC,10 + BitmapSize.x + 5,10,
  100.              Trunc(BitmapSize.x * Factor),Trunc(BitmapSize.y * Factor),
  101.              MemDC,
  102.              0,0,BitmapSize.x,BitmapSize.y,srcCopy);
  103.  
  104.   { Get rid of the memory DC }
  105.   SelectObject(MemDC,OldBitmap);
  106.   DeleteDC(MemDC);
  107. End {Paint};
  108.  
  109. {---------------------------------------------------}
  110.  
  111. Procedure BlitWindow.WMLButtonDown(Var Msg : TMessage);
  112.  
  113. Begin
  114.   Factor := Factor + 0.5;
  115.   InvalidateRect(HWindow,Nil,False);
  116. End {WMLButtonDown};
  117.  
  118. {---------------------------------------------------}
  119.  
  120. Procedure BlitWindow.WMRButtonDown(Var Msg : TMessage);
  121.  
  122. Begin
  123.   If Factor > 1.0
  124.     Then Begin
  125.            Factor := Factor - 0.5;
  126.            InvalidateRect(HWindow,Nil,True);
  127.          End;
  128. End {WMRButtonDown};
  129.  
  130. {---------------------------------------------------}
  131.  
  132. { --- Main --- }
  133.  
  134. Var
  135.   BlitApp : TBlitApp;
  136.  
  137. Begin
  138.   BlitApp.Init('Blit4App');
  139.   BlitApp.Run;
  140.   BlitApp.Done;
  141. End.
  142.